home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22o.zip / MULTID.4TH < prev    next >
Text File  |  1994-08-13  |  16KB  |  597 lines
  1. \ ForthCMP  Multitasking Module
  2. \ Copyright 1985, 1993 (C) By Thomas Almy.  All rights reserved.
  3.  
  4. \ Permission is granted to registered users of ForthCMP to sell or distribute
  5. \ computer programs incorporating the compiled contents of this file.
  6.  
  7. \ This module writes direct to the display for terminal I/O
  8.  
  9.  
  10. .( LOADING MULTID) CR
  11. INCLUDE INTS
  12. INCLUDE FARMEM1
  13. 10 HEX
  14.  
  15. \ If EGA is defined non-zero then 43 line EGA code is generated
  16. FIND EGA #IF DROP #ELSE 0 CONSTANT EGA #THEN
  17.  
  18. \ If VGA is defined non-zero then 50 line VGA code is generated
  19. FIND VGA #IF DROP #ELSE 0 CONSTANT VGA #THEN
  20.  
  21. EGA 0<> VGA 0<> OR CONSTANT ENHANCED
  22.  
  23. ENHANCED #IF 0 CONSTANT VID-DELAY #THEN  \ no vid delay if EGA or VGA
  24. ENHANCED 0=  #IF VARIABLE crtport  3D4 crtport ! #THEN
  25.  
  26. \ If VID-DELAY is defined non-zero then anti-snow code is added
  27. FIND VID-DELAY #IF DROP #ELSE 0 CONSTANT VID-DELAY #THEN
  28.  
  29. VARIABLE vidseg     \ VIDEO SEGMENT
  30. B800 vidseg !
  31. 50 CONSTANT c/l     \ Characters per line
  32. EGA #IF 2B #ELSE VGA #IF 32 #ELSE 19 #THEN #THEN
  33.    CONSTANT l/s     \ lines per screen
  34.  
  35.  
  36. DECIMAL  
  37. 0 0 IN/OUT NEED SINGLE 
  38. 0 0 IN/OUT NEED MULTI
  39. 0 0 IN/OUT NEED PAUSE
  40. 0 0 IN/OUT NEED end-timer
  41. 0 0 IN/OUT NEED start-timer
  42. 0 0 IN/OUT NEED CLS
  43.  
  44.  
  45. VARIABLE ?multi         \ true if multitasking turned on
  46. VARIABLE user           \ disp into user segment--used at comp time
  47. VARIABLE CTASK          \ pointer to task list
  48. VARIABLE inexpect       \ executing EXPECT -- only one at a time, please!
  49.  
  50.  \ Semaphores
  51.  
  52. 1 0 IN/OUT
  53. : SEMA BEGIN DUP @ WHILE PAUSE REPEAT ON ;
  54.  
  55. 1 0 IN/OUT
  56. : PHORE  OFF PAUSE ;
  57.  
  58.  
  59. 0 0 IN/OUT 
  60. : BYE  unsetup-vid end-timer bye ;
  61.  
  62.  \ Memory management interface
  63. 1 1 IN/OUT
  64. : GET malloc IF    ." OUT OF MEMORY " BYE THEN ;
  65.  
  66.  \ USER VARIABLES 
  67. H: UALLOT  DSEG user @  +  user ! ;
  68. 1 2 IN/OUT
  69. H: UCREATE user @ CONSTANT ;
  70. H: UVARIABLE UCREATE 2 UALLOT ;
  71. H: URESET DSEG  0 user ! ;
  72. URESET
  73.  \ redefinition of primitive I/O functions
  74. HEX
  75. 1 0 IN/OUT
  76. : storecursor ( DISPL -- )  CTASK @ 12 + CS: ! ;
  77.  
  78. 1 0 IN/OUT
  79. : setcursor (  DISPL -- )  
  80. ENHANCED #IF
  81.     2/ DUP 0F 3D4 PC! 3D5 PC! >< 0E 3D4 PC! 3D5 PC! 
  82. #ELSE
  83.     2/ DUP 0F crtport @ PC! crtport @ 1+ PC!
  84.     >< 0E crtport @ PC! crtport @ 1+ PC! 
  85. #THEN
  86. ;
  87.  
  88. 0 0 IN/OUT
  89. : nocursor  l/s c/l * 2* 1- setcursor ( OFF SCREEN ! ) ;
  90.  
  91. 2 0 IN/OUT
  92. : GOTOXY  c/l * + 2*  storecursor ;
  93.  
  94.  
  95. ENHANCED #IF
  96. 0 0 IN/OUT
  97. EGA #IF
  98. CODE set-ega
  99.     03 # AX MOV  10 INT                     \ SET MODE 3
  100.     1112 # AX MOV  0 # BL MOV  10 INT       \ Load 8X8 font
  101.     1200 # AX MOV  20 # BL MOV  10 INT      \ Load new printscreen
  102.     1 # AH MOV  707 # CX MOV  10 INT        \ LOAD CURSOR SCAN LINES
  103.     3D4 # DX MOV  0A # AL MOV  [DX] BYTE OUT \ set cursor 
  104.     FWD, THEN,
  105.     DX INC
  106.     6 # AL MOV  [DX] OUT
  107.     RET
  108. END-CODE
  109. #ELSE  \ must be VGA
  110. CODE set-ega
  111.     1202 # AX MOV 30 # BL MOV 10 INT  \ 400 scan lines
  112.     03 # AX MOV  10 INT                     \ SET MODE 3
  113.     1112 # AX MOV  0 # BL MOV  10 INT       \ Load 8X8 font
  114.     1200 # AX MOV  20 # BL MOV  10 INT      \ Load new printscreen
  115.     RET
  116. END-CODE
  117. #THEN
  118.  
  119. 0 0 IN/OUT
  120. CODE unset-ega
  121. VGA #IF
  122.     1201 # AX MOV 30 # BL MOV 10 INT  \ 350 scan lines
  123. #THEN
  124.     03 # AX MOV  10 INT  RET  END-CODE
  125. #THEN 
  126.  
  127. 0 0 IN/OUT
  128. : setup-vid
  129. ENHANCED #IF
  130.     set-ega
  131.     CTASK @ 12 + CS: OFF    \ home cursor
  132. #ELSE
  133.     40 49 C@L 7 = IF 3B4 crtport ! B000 vidseg ! THEN \ MONOCHROME
  134.     40 50 C@L 40 51 C@L GOTOXY
  135.     vidseg @  c/l l/s 1- * 2* 1+ C@L  CTASK @ 14 + CS: ! 
  136. #THEN
  137. ;
  138.  
  139.  CODE unsetup-vid  
  140. ENHANCED #IF
  141.     CALL' CLS
  142.     CALL' unset-ega
  143.     DX DX XOR
  144. #ELSE
  145.     CTASK [] BX MOV
  146.     CS: 12 +[BX] AX MOV  \ cursor offset
  147.     c/l # BX MOV 
  148.     DX DX XOR
  149.     AX 1 SAR  
  150.     BX IDIV
  151.     AL DH MOV  
  152. #THEN
  153.     2 # AH MOV 
  154.     BH BH XOR  
  155.     10 INT  
  156.     RET 
  157. END-CODE \ unsetup-vid
  158.  
  159. CODE scrmove  ( source dest wordCount -- )
  160.     BX POP 
  161.     CX POP
  162.     DI POP
  163.     SI POP
  164.     LOOP IF,
  165.         DS PUSHSEG
  166. VID-DELAY #IF  
  167.         B800 # vidseg [] CMP  =0 IF,
  168.             3DA # DX MOV
  169.             BEGIN,  
  170.                 BYTE [DX] IN  
  171.                 8 # AL TEST  
  172.             =0 ~ UNTIL,
  173.             DX DEC
  174.             DX DEC
  175.             21 # AL MOV
  176.             BYTE [DX] OUT
  177.         THEN, 
  178. #THEN
  179.         vidseg [] AX MOV
  180.         AX DS >SEG
  181.         AX ES >SEG
  182.         REPZ MOVS
  183.         DS POPSEG
  184. VID-DELAY #IF
  185.         B800 # vidseg [] CMP  =0 IF,
  186.             3D8 # DX MOV
  187.             29 # AL MOV
  188.             BYTE [DX] OUT
  189.         THEN, 
  190. #THEN
  191.     THEN, 
  192.     BX JMPI 
  193. END-CODE \ scrmove
  194.  
  195. 2 0 IN/OUT
  196. CODE scrfill ( source wordCount -- )
  197.     vidseg [] ES >SEG
  198.     20 # BYTE ES: [BX] MOV
  199.     CTASK [] DI MOV
  200.     CS: 14 +[DI] CL MOV  \ style
  201.     CL ES: 1 +[BX] MOV
  202.     BX PUSH
  203.     BX INC 
  204.     BX INC 
  205.     BX PUSH  
  206.     AX DEC 
  207.     AX PUSH
  208.     CALL' scrmove
  209.     RET
  210. END-CODE \ scrfill
  211.  
  212. 0 0 IN/OUT
  213. : scrollup  c/l 2*  0  c/l l/s 1- * scrmove
  214.     c/l l/s 1- * 2*  c/l    scrfill
  215.     c/l l/s 1- * 2*  CTASK @ 12 + CS: ! ( set cursor ) ;
  216.  
  217. 0 2 IN/OUT
  218. : ?XY     CTASK @ 12 + CS: @  2/  0 c/l UM/MOD ;
  219.  
  220. 1 0 IN/OUT
  221. : FOREGROUND 0F AND CTASK @ 14 + TUCK CS: @ F0 AND OR SWAP CS: ! ;
  222.  
  223. 1 0 IN/OUT
  224. : BACKGROUND 7 AND 4 << CTASK @ 14 + TUCK CS: @ 0F AND OR SWAP CS: ! ;
  225.  
  226.  
  227. : EMIT  
  228.     CTASK @ 12 + CS: @  c/l l/s * 2* >= IF scrollup THEN
  229.     vidseg @ CTASK @ 12 + CS: @ C!L
  230.     CTASK @ 14 + CS: @ vidseg @ CTASK @ 12 + CS: @ 1+ C!L
  231.     CTASK @ 12 + CS: @ 2+ storecursor  PAUSE ;
  232.  
  233. : CR
  234.     CTASK @ 12 + CS: @  
  235.     c/l 2*  U/  1+  c/l 2*  *
  236.     DUP c/l l/s * 2* = IF DROP scrollup  CTASK @ 12 + CS: @ THEN
  237.     storecursor  PAUSE ;
  238.  
  239. : SPACES
  240.     DUP 0> IF
  241.         c/l l/s * 2*  CTASK @ 12 + CS: @ - OVER 2* < IF ( too big )
  242.         0 DO BL EMIT LOOP ELSE
  243.             CTASK @ 12 + CS: @  SWAP 2DUP scrfill
  244.         2* + storecursor  PAUSE 
  245.         THEN 
  246.     ELSE   DROP
  247.     THEN
  248. ;
  249.  
  250.  
  251. 2 1 IN/OUT
  252. CODE (type) ( AX has count, BX has string, result is cursor position )
  253.     BX SI MOV
  254.     CTASK [] BX MOV
  255.     CS: 12 +[BX] DI MOV \ cursor
  256.     AX CX MOV
  257.     CS: 14 +[BX] AH MOV \ style
  258.     vidseg [] ES >SEG
  259.     LOOP IF, 
  260.         BEGIN,
  261.             BYTE LODS
  262.             STOS  
  263.         LOOP ~ UNTIL,
  264.     THEN,
  265.     DI AX MOV       \ final cursor position
  266.     RET
  267. END-CODE \ (type)
  268.  
  269. : TYPE 
  270.     c/l l/s * 2*  CTASK @ 12 + CS: @ - OVER 2* < IF ( too big )
  271.         0 ?DO COUNT EMIT LOOP DROP
  272.     ELSE 
  273.         (type) storecursor PAUSE 
  274.     THEN ;
  275.  
  276. 2 1 IN/OUT
  277. CODE (cs:type) ( AX has count, BX has string, result is cursor position)
  278.     BX SI MOV
  279.     CTASK [] BX MOV
  280.     CS: 12 +[BX] DI MOV \ cursor
  281.     AX CX MOV
  282.     CS: 14 +[BX] AH MOV \ style
  283.     vidseg [] ES >SEG
  284.     LOOP IF, 
  285.         BEGIN,
  286.             CS: BYTE LODS
  287.             STOS  
  288.         LOOP ~ UNTIL,
  289.     THEN,
  290.     DI AX MOV       \ final cursor position
  291.     RET
  292. END-CODE \ (cs:type)
  293.  
  294. : CS:TYPE 
  295.     c/l l/s * 2* CTASK @ 12 + CS: @ - OVER 2* < IF ( too big )
  296.         0 ?DO CS: COUNT EMIT LOOP DROP
  297.     ELSE 
  298.         (cs:type) storecursor PAUSE 
  299.     THEN ;
  300.  
  301.  
  302. 0 0 IN/OUT 
  303. : CLS  0  c/l l/s *  scrfill  0 storecursor ;
  304.  
  305. 0 1 IN/OUT
  306. CODE ?TERMINAL 
  307.     CALL' PAUSE     \ allow another task to execute
  308.     1 # AH MOV 
  309.     16 INT 
  310.     0 # AX MOV
  311.     =0 ~ IF, AX DEC  THEN,
  312.     RET
  313. END-CODE \ ?TERMINAL
  314.  
  315. : PAD CTASK @ 16 + CS: @ ;
  316.  
  317.  
  318. : KEY  BEGIN ?TERMINAL  CTASK @ 12 + CS: @ setcursor UNTIL  
  319.     0 8 BDOS 
  320.     PAUSE
  321.     nocursor ;
  322.  
  323.  \ EXPECT
  324. FIND SPAN #IF DROP #ELSE VARIABLE SPAN #THEN
  325.  
  326. 0 0 IN/OUT
  327. : bu  CTASK @ 12 + CS: @ 2- DUP storecursor BL EMIT storecursor -1 SPAN +! ;
  328.  
  329. DECIMAL
  330.  
  331. : EXPECT
  332.     inexpect SEMA       \ too hard if two or more tasks want input at once!
  333.     SPACE
  334.     >R SPAN OFF
  335.     BEGIN
  336.         SPAN @ R@ < WHILE       \ more room on line
  337.         KEY  CASE
  338.         27 OF BEGIN SPAN @ 0> WHILE bu REPEAT  ENDOF
  339.         8  OF SPAN @ 0> IF bu THEN ENDOF
  340.         13 OF BL EMIT
  341.               R> DROP DROP 
  342.               inexpect PHORE 
  343.               EXIT ENDOF
  344.         ( ELSE ) DUP EMIT 
  345.                  OVER SPAN @ + C! 
  346.                  1 SPAN +!
  347.         0 ENDCASE
  348.     REPEAT
  349.     inexpect PHORE
  350.     R> 2DROP ;
  351.  
  352.  
  353.  \ TASK CREATION 
  354. HEX
  355. H: TASK                          \ values after INIT-TASKS:
  356.    CSEG FORCE CREATE HERE E92E , \ DISP 0 -- JMP ( task asleep )
  357.    DSEG CTASK @ ,  CTASK !    \     02 -- relative addr nxt task
  358.    user @ ,                   \     04 -- size of user area (not used?)
  359.    0 ,                        \     06 -- SS register contents
  360.    user @ pssize 10 * + ,     \     08 -- SP register contents
  361.    user @ pssize 10 * + rssize + , \     0A -- BP register contents
  362.    ,                          \     0C -- PC contents
  363. \ the following fields are for per-task variables
  364. \ and could be selectively elimiated if not needed if space is 
  365. \ at a premium.  In that case, offsets may need to be adjusted
  366. \ for words which use latter fields.
  367.    0 ,                        \     0E -- Message list
  368.    0 ,                        \     10 -- Timer
  369.    0 ,                        \     12 -- Cursor location
  370.    7 ,                        \     14 -- character attribute (style)
  371.    DSEG HERE 80 ALLOT 20 + ,  \     16 -- PAD, a per-task work area
  372. ; 
  373. 0 #IF
  374. Initially, DISP 2 has absolute address of next task.
  375. This values as well as DISP 6 get
  376. filled in by INIT-TASKS when application is run.
  377. #THEN
  378.  
  379. CSEG FORCE  HERE  CREATE MAIN-TASK  \ Give it a name
  380. DSEG CTASK !                    \ Task list points to it
  381. 80CD ,                          \ DISP 0 -- INT 80 (task awake)
  382.    0 ,                          \ 02 -- relative addr next task
  383.    0 ,                          \ 04 -- NOT USED
  384.    0 ,                          \ 06 -- SS register contents
  385.    0 ,                          \ 08 -- SP register contents
  386.    0 ,                          \ 0A -- BP register contents
  387.    0 ,                          \ 0C -- PC contents
  388.    0 ,                          \ 0E -- Message list
  389.    0 ,                          \ 10 -- Timer
  390.    0 ,                          \ 12 -- Cursor Location
  391.    7 ,                          \ 14 -- Style
  392.    DSEG HERE 80 ALLOT 20 + ,    \ 16 -- PAD, a per-task work area
  393. 0 #IF
  394. DISP-2, 6, and 12 get filled in by INIT-TASK.  -8 -0A and -0C
  395. are filled by first task swap (which is done by INIT-TASK).
  396. #THEN
  397.  
  398.  \ TASK INITIALIZATION
  399. 0 0 IN/OUT 
  400. : INIT-TASKS \ This MUST be executed to start multitasking
  401.     CTASK @
  402.     BEGIN ?DUP WHILE  \ for each task DO:
  403.         2+ DUP CS: @ IF  \ one follows, this isnt main task
  404.             DUP 8 + CS: @ 10 + 4 >>  GET 
  405.          OVER 4 + CS: ! \ stackseg
  406.             DUP CS: @ TUCK   \ next task
  407.         ELSE
  408.             0 SWAP CTASK @ \ next task is head of list
  409.         THEN
  410.         OVER - 2- SWAP CS: !  
  411.     REPEAT
  412.     MAIN-TASK CTASK !  
  413.     setup-vid
  414.     ?SS: MAIN-TASK 6 + CS: !    \ sets main task stack segment
  415.     start-timer
  416.     MULTI ( GO!!! ) ;
  417.  
  418.  \ TASK DISPATCHER
  419. CODE PAUSE  
  420.     0 # ?multi [] CMP  
  421.     =0 IF, RET THEN,
  422.     CTASK [] BX MOV         \ current task
  423.     CS: 0C +[BX] POP        \ save PC
  424.     BP CS: 0A +[BX] MOV     \ save BP
  425.     SP CS: 08 +[BX] MOV     \ save SP
  426.     CS: 2 +[BX] BX ADD  
  427.     4 # BX ADD  
  428.     CLI                \ no ints during dispatch!
  429.     BX JMPI  ( dispatch )
  430. END-CODE \ PAUSE
  431.  
  432. 0 #IF
  433. Tasks are linked together so that jumping to a task will cause
  434. jumping to the next if it is asleep, or doing an INT 80 if it
  435. is awake.  Thanks to Henry Laxen's Forth 83 model for the
  436. technique.
  437. #THEN
  438.  
  439. L: start-task ( the INT80 routine )  
  440.     BX POP 
  441.     BX DEC 
  442.     BX DEC                  \ Pointer to the task
  443.     CS: 6 +[BX] SS >SEG     \ restore stack segment
  444.     CS: 8 +[BX] SP MOV      \ restore SP
  445.     STI                     \ Interrupts are safe now
  446.     CS: 0A +[BX] BP MOV     \ restore BP
  447.     BX  CTASK [] MOV        \ current task
  448.     CS: 0C +[BX] JMPI       \ go!
  449. FORTH \ start-task 
  450. 0 #IF
  451. This code starts up a new task by setting up all registers,
  452. fixing CTASK and USERP, and jumping to where we left off.
  453. #THEN
  454.  
  455.  \ TASK MANAGEMENT
  456. : SINGLE  ?multi OFF ;
  457.  
  458. : MULTI   ?multi ON
  459.     ?CS: start-task 80 set-handler  \ install interrupt vector
  460.     PAUSE  \ start with a task swap
  461. ;
  462.  
  463. 1 0 IN/OUT
  464. : WAKE  80CD CS: <- ;
  465.  
  466. 1 0 IN/OUT
  467. \ the 2e prefix byte (CS override) makes the jmp instruction 4 bytes long
  468. : SLEEP (  task -- )   E92E CS: <- ;
  469.  
  470. 1 1 IN/OUT
  471. : WAITING?  10 + CS: @ 0<> ;
  472.  
  473. 0 0 IN/OUT
  474. : STOP  CTASK @ SLEEP PAUSE ;
  475.  
  476. 0 1 IN/OUT
  477. : ACTIVE-TASKS
  478.     0 MAIN-TASK
  479.     BEGIN
  480.         DUP WAITING? IF SWAP 1+ SWAP ELSE 
  481.             DUP CS: @ 80CD = IF SWAP 1+ SWAP THEN THEN \ check for active
  482.         DUP 2+ CS: @ + 4 + \ address of next task
  483.     DUP MAIN-TASK = UNTIL     \ Loop until back to start
  484.     DROP ( task address )
  485. ;
  486.  
  487.  \ MESSAGE PASSING
  488. 0 1 IN/OUT
  489. : MESSAGE?  CTASK @ 0E + CS: @ ;
  490.  
  491. 0 1 IN/OUT
  492. : GET-MESSAGE  
  493.   BEGIN MESSAGE? ?DUP 0= WHILE STOP REPEAT
  494.   DUP  0 @L  CTASK @ 0E + CS: !  \ Unlink message
  495. ;   
  496.  
  497. 1 1 IN/OUT
  498. : MESSAGES 
  499.     0 SWAP 0E + CS: @ ?DUP IF
  500.         BEGIN SWAP 1+ SWAP  0 @L  ?DUP 0= UNTIL
  501.     THEN ;
  502.  
  503. 2 0 IN/OUT
  504. : SEND-MESSAGE 
  505.     OVER 0 SWAP 0 !L        \ set message's next field to NIL
  506.     DUP WAITING? NOT IF DUP WAKE THEN \ fire up receiving task
  507.                                 \ unless waiting for timer
  508.     0E + DUP CS: @ ?DUP IF  \ Existing messages in queue
  509.         NIP
  510.         BEGIN DUP 0 @L ?DUP WHILE NIP REPEAT \ find end of list
  511.         0 !L  \ store message at end of list
  512.     ELSE
  513.         CS: !     \ no existing messages, put at head of queue.
  514.     THEN
  515.     PAUSE ;  \ Give it a chance to run
  516.  
  517.  \ control-break handler
  518. \ always gets control and (currently) dumps task information
  519.  
  520. 2VARIABLE cb_save
  521.  
  522. 1B CONSTANT cb_int
  523.  
  524. 0 0 IN/OUT
  525. : cbt  
  526.     CLS 
  527.     SINGLE
  528.     end-timer
  529.     ." Task statistics: "
  530.     MAIN-TASK \ start with first
  531.     BEGIN CR
  532.         HEX DUP 0 <# # # # # #> TYPE SPACE \ address
  533.         DUP WAITING? IF ." Waiting " DUP 10 + CS: @ . ." ticks" ELSE 
  534.             DUP CS: @ 80CD = IF ." Active" ELSE ." Sleeping" THEN THEN 
  535.         DUP 2+ CS: @ + 4 + \ address of next task
  536.     DUP MAIN-TASK = UNTIL     \ Loop until back to start
  537.     DROP ( task address )
  538. EGA #IF
  539.     CR ." Hit any key when finished"    KEY DROP
  540. #THEN
  541.     unsetup-vid
  542.     bye
  543. ;
  544.  
  545.  
  546. ' cbt TASK cb-task
  547.  
  548.  
  549. L: cb_handler ( actual interrupt handler )
  550.       80CD # CS: cb-task [] MOV \ wake cb task
  551.     STI
  552.     IRET FORTH
  553.  
  554.  
  555.  \ timer
  556. 1C CONSTANT t_int               \ timer interupt vector number
  557. CSEG FORCE 
  558. CREATE t_save 4 ALLOT           \ original interupt vector
  559. L: t_handler
  560.     PUSHF CS: t_save CALLF    \ do original functions
  561.     BX PUSH
  562.     MAIN-TASK # BX MOV ( start of list )
  563.     BEGIN,  
  564.         CS: 0 # 10 +[BX] CMP =0 ~ IF, ( non_zero time )
  565.             CS: 10 +[BX] DEC  ( count down )
  566.             =0 IF, 80CD # CS: [BX] MOV THEN, ( wake task )
  567.         THEN,
  568.         CS: 2 +[BX] BX ADD 
  569.         4 # BX ADD ( next task )
  570.         MAIN-TASK # BX CMP  
  571.     =0 UNTIL, ( back at start? )
  572.     BX POP 
  573.     IRET
  574. FORTH \ t_handler
  575.  
  576. \ timer start and end                          08:09 11/18/85
  577.  
  578. : start-timer  \ and control break handler
  579.     t_int get-handler  t_save CS: 2!
  580.     ?CS: t_handler t_int set-handler
  581.     cb_int get-handler cb_save 2!
  582.     ?CS: cb_handler cb_int set-handler
  583. ;
  584.  
  585. : end-timer
  586.     t_save CS: 2@  t_int set-handler
  587.     cb_save 2@ cb_int set-handler
  588. ;
  589.  
  590. 2 0 IN/OUT
  591. : TIME-OUT ( ticks task -- )  DUP SLEEP 10 + CS: ! ;
  592.  
  593. 1 0 IN/OUT
  594. : WAIT ( ticks -- ) CTASK @ TIME-OUT PAUSE ;
  595.  
  596. DSEG 0A = #IF DECIMAL #THEN
  597.